home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / hyperbole / kotl / kview.el < prev    next >
Encoding:
Text File  |  1995-08-26  |  36.5 KB  |  971 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         kview.el
  4. ;; SUMMARY:      Display handling of koutlines.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     outlines, wp
  7. ;;
  8. ;; AUTHOR:       Bob Weiner & Kellie Clark
  9. ;;
  10. ;; ORIG-DATE:    6/30/93
  11. ;; LAST-MOD:     25-Aug-95 at 00:31:48 by Bob Weiner
  12. ;;
  13. ;; This file is part of Hyperbole.
  14. ;; Available for use and distribution under the same terms as GNU Emacs.
  15. ;;
  16. ;; Copyright (C) 1993-1995, Free Software Foundation, Inc.
  17. ;; Developed with support from Motorola Inc.
  18. ;;
  19. ;; DESCRIPTION:  
  20. ;; DESCRIP-END.
  21.  
  22. ;;; ************************************************************************
  23. ;;; Other required Lisp Libraries
  24. ;;; ************************************************************************
  25. (mapcar 'require '(klabel kfill hypb))
  26.  
  27. ;;; ************************************************************************
  28. ;;; Public variables
  29. ;;; ************************************************************************
  30.  
  31. (set-default 'kview nil)
  32.  
  33. (defvar kview:default-label-min-width 4
  34.   "*Minimum width to which to pad labels in a kotl view.
  35. Labels are padded with spaces on the left.")
  36.  
  37. (defvar kview:default-label-separator "  "
  38.   "*Default string of characters to insert between label and contents of a kotl cell view.")
  39.  
  40. (defvar kview:default-label-type 'alpha
  41.   "*Default label-type to use for new views.
  42. It must be one of the following symbols:
  43.   no              for no labels
  44.   id              for permanent idstamp labels, e.g. 001, 002, etc.
  45.   alpha           for '1a2' full alphanumeric labels
  46.   legal           for '1.1.2' labels
  47.   partial-alpha   for partial alphanumeric labels, e.g. '2' for node '1a2'
  48.   star            for multi-star labeling, e.g. '***'.")
  49.  
  50. (defvar kview:default-level-indent 3
  51.   "*Default number of spaces to indent each succeeding level in kotl views.")
  52.  
  53. ;;; ************************************************************************
  54. ;;; Public functions
  55. ;;; ************************************************************************
  56.  
  57. ;;;
  58. ;;; kcell-view
  59. ;;;
  60.  
  61. (defun kcell-view:backward (&optional visible-p label-sep-len)
  62.   "Move to start of the prior cell at the same level as the current cell.
  63. With optional VISIBLE-P, consider only visible cells.
  64. Return t unless no such cell."
  65.   (or label-sep-len (setq label-sep-len
  66.               (kview:label-separator-length kview)))
  67.   (let ((opoint (point))
  68.     (found) (done)
  69.     (curr-indent 0)
  70.     (start-indent (kcell-view:indent nil label-sep-len)))
  71.     (while (and (not (or found done))
  72.         (kcell-view:previous visible-p label-sep-len))
  73.       (if (bobp)
  74.       (progn (setq done t)
  75.          (goto-char opoint))
  76.     (setq curr-indent (kcell-view:indent nil label-sep-len))
  77.     (cond ((= curr-indent start-indent)
  78.            (goto-char (kcell-view:start nil label-sep-len))
  79.            (setq found t))
  80.           ((< curr-indent start-indent)
  81.            ;; Went past start of this tree without a match.
  82.            (setq done t)
  83.            (goto-char opoint))
  84.           ;; else go to prior node
  85.           )))
  86.     found))
  87.  
  88. (defun kview:beginning-of-actual-line ()
  89.   "Go to the beginning of the current line whether collapsed or not."
  90.   (if (re-search-backward "[\n\^M]" nil 'move)
  91.       (forward-char 1)))
  92.  
  93. (defun kcell-view:cell (&optional pos)
  94.   "Return kcell at optional POS or point."
  95.   (kproperty:get (kcell-view:plist-point pos) 'kcell))
  96.  
  97. (defun kcell-view:child (&optional label-sep-len)
  98.   "Move to start of current cell's child within current view.
  99. Return t unless cell has no child.
  100. Optional LABEL-SEP-LEN is the length of the separation between
  101. a cell's label and the start of its contents."
  102.   (let* ((opoint (point))
  103.      (prev-indent (kcell-view:indent nil label-sep-len))
  104.      (next (kcell-view:next nil label-sep-len)))
  105.     (or label-sep-len (setq label-sep-len
  106.                 (kview:label-separator-length kview)))
  107.     ;; Since kcell-view:next leaves point at the start of a cell, the cell's
  108.     ;; indent is just the current-column of point.
  109.     (if (and next (> (current-column) prev-indent))
  110.     t
  111.       ;; Move back to previous point and return nil.
  112.       (goto-char opoint)
  113.       nil)))
  114.  
  115. (defun kcell-view:collapse (&optional pos label-sep-len)
  116.   "Collapse cell at optional POS or point within the current view."
  117.   (save-excursion
  118.     (goto-char (kcell-view:start pos label-sep-len))
  119.     (subst-char-in-region (point) (kcell-view:end-contents) ?\n ?\^M t)))
  120.  
  121. (defun kcell-view:collapsed-p (&optional pos label-sep-len)
  122.   "Return t if cell at optional POS or point is collapsed within the current view."
  123.   (save-excursion
  124.     (goto-char (kcell-view:start pos label-sep-len))
  125.     (if (search-forward "\^M" (kcell-view:end-contents) t)
  126.     t)))
  127.  
  128. (defun kcell-view:contents ()
  129.   "Return contents of current kview cell as a string."
  130.   (let ((indent (kcell-view:indent))
  131.     (start (kcell-view:start))
  132.     (end (kcell-view:end-contents)))
  133.     ;; Remove indentation from all but first line.
  134.     (hypb:replace-match-string
  135.      (concat "\\([\n\^M]\\)" (make-string indent ?\ ))
  136.      (buffer-substring start end) "\\1")))
  137.  
  138. (defun kcell-view:create (kview cell level klabel &optional no-fill)
  139.   "Insert into KVIEW at point, CELL at LEVEL (1 = first level) with KLABEL.
  140. Optional NO-FILL non-nil suppresses filling of cell's contents upon insertion."
  141.   (if (= (kcell:idstamp cell) 0)
  142.       nil
  143.     (let* ((label-min-width (kview:label-min-width kview))
  144.        (label-fmt (format "%%%ds" label-min-width))
  145.        (label (if (string= klabel "") "" (format label-fmt klabel)))
  146.        (label-separator (if (string= klabel "") " "
  147.                   (kview:label-separator kview)))
  148.        (mult-line-indent (* (1- level) (kview:level-indent kview)))
  149.        (thru-label (+ mult-line-indent label-min-width
  150.               (length label-separator)))
  151.        (old-point (point))
  152.        (fill-prefix (make-string thru-label ?\ ))
  153.        contents
  154.        new-point)
  155.       (if no-fill (kcell:set-attr cell 'no-fill t))
  156.       (insert fill-prefix)
  157.       (setq contents (kview:insert-contents cell nil no-fill))
  158.       ;; Insert lines to separate cell from next.
  159.       (insert (if (or no-fill (equal contents ""))
  160.           "\n\n" "\n"))
  161.       (kfile:narrow-to-kcells)
  162.       (setq new-point (point))
  163.       (goto-char old-point)
  164.       ;; Delete leading spaces used to get fill right in first cell
  165.       ;; line.  Replace it with label.
  166.       (delete-char thru-label)
  167.       (insert (format
  168.            (format "%%%ds" (- thru-label (length label-separator)))
  169.            label))
  170.       (setq old-point (point))
  171.       (insert label-separator)
  172.       (goto-char old-point)
  173.       ;; Add cell's properties to the text property list at point.
  174.       (kproperty:set 'kcell cell)
  175.       (goto-char new-point))))
  176.  
  177. (defun kcell-view:end (&optional pos)
  178.   "Return end position of cell from optional POS or point.
  179. Includes blank lines following cell contents."
  180.   (or pos (setq pos (point)))
  181.   (save-excursion
  182.     (or (re-search-forward "[\n\^M][\n\^M]" nil t)
  183.     (point-max))))
  184.  
  185. (defun kcell-view:end-contents (&optional pos)
  186.   "Return end position of cell contents from optional POS or point.
  187. Excludes blank lines following cell contents."
  188.   (save-excursion
  189.     (if pos (goto-char pos))
  190.     (goto-char (kcell-view:end))
  191.     (skip-chars-backward "\n\^M")
  192.     (point)))
  193.  
  194. (defun kcell-view:expand (&optional pos label-sep-len)
  195.   "Expand cell at optional POS or point within the current view."
  196.   (save-excursion
  197.     (goto-char (kcell-view:start pos label-sep-len))
  198.     (subst-char-in-region (point) (kcell-view:end-contents) ?\^M ?\n t)))
  199.  
  200. (defun kcell-view:forward (&optional visible-p label-sep-len)
  201.   "Move to start of the following cell at the same level as the current cell.
  202. With optional VISIBLE-P, consider only visible cells.
  203. Return t unless no such cell."
  204.   (or label-sep-len (setq label-sep-len
  205.               (kview:label-separator-length kview)))
  206.   (let ((opoint (point))
  207.     (found) (done)
  208.     (curr-indent 0)
  209.     (start-indent (kcell-view:indent nil label-sep-len)))
  210.     (while (and (not (or found done))
  211.         (kcell-view:next visible-p label-sep-len))
  212.       (setq curr-indent (kcell-view:indent nil label-sep-len))
  213.       (cond ((= curr-indent start-indent)
  214.          (goto-char (kcell-view:start nil label-sep-len))
  215.          (setq found t))
  216.         ((< curr-indent start-indent)
  217.          ;; Went past end of this tree without a match.
  218.          (setq done t)
  219.          (goto-char opoint))
  220.         ;; else go to following node
  221.         ))
  222.     ;; If didn't find a match, return to original point.
  223.     (or found (goto-char opoint))
  224.     found))
  225.  
  226. (defun kcell-view:get-attr (attribute &optional pos)
  227.   "Get ATTRIBUTE's value for current cell or cell at optional POS."
  228.   (interactive "SAttribute to get: ")
  229.   (save-excursion
  230.     (if pos (goto-char pos))
  231.     (let ((value (kcell:get-attr (kcell-view:cell) attribute)))
  232.       (if (interactive-p)
  233.       (message "Attribute %s = %s, in cell <%s>."
  234.            attribute value (kcell-view:label)))
  235.       value)))
  236.  
  237. (defun kcell-view:idstamp (&optional pos)
  238.   "Return idstamp string of cell at optional POS or point."
  239.   (save-excursion
  240.     (if pos (goto-char pos))
  241.     (format "0%d" (kcell:idstamp (kcell-view:cell)))))
  242.  
  243. (defun kcell-view:indent (&optional pos label-sep-len)
  244.   "Return indentation of cell at optional POS or point.
  245. Optional LABEL-SEP-LEN is the view-specific length of the separator between a
  246. cell's label and the start of its contents."
  247.   (or (+ (save-excursion
  248.        (kcell-view:to-label-end pos)
  249.        (current-column))
  250.      (or label-sep-len (kview:label-separator-length kview)))
  251.       (error "(kcell-view:indent): No internal cell properties at %s"
  252.          (or pos "point"))))
  253.  
  254. (defun kcell-view:label (&optional pos)
  255.   "Return displayed label string of cell at optional POS or point.
  256. If labels are off, return cell's idstamp as a string."
  257.   (save-excursion
  258.     (if pos (goto-char pos))
  259.     (let ((label-type (kview:label-type kview)))
  260.       (if (eq label-type 'no)
  261.       (kcell-view:idstamp)
  262.     (kcell-view:to-label-end)
  263.     (buffer-substring (point) (progn (skip-chars-backward "^ \t\n\^M")
  264.                      (point)))))))
  265.  
  266. (defun kcell-view:level (&optional pos label-sep-len indent)
  267.   "Return cell level relative to top cell of the outline for current cell or one at optional POS.
  268. 0 = top cell level, 1 = 1st level in outline.
  269. Optional LABEL-SEP-LEN is length of spaces between a cell label and its the
  270. start of its body in the current view.  Optional INDENT is the indentation in
  271. characters of the cell whose level is desired."
  272.   (or label-sep-len (setq label-sep-len (kview:label-separator-length kview)))
  273.   (save-excursion
  274.     (if pos (goto-char pos))
  275.     (/ (- (or indent (kcell-view:indent nil label-sep-len)) label-sep-len)
  276.        (kview:level-indent kview))))
  277.  
  278. (defun kcell-view:line (&optional pos)
  279.   "Return contents of cell line at point or optional POS as a string."
  280.   (save-excursion
  281.     (if pos (goto-char pos))
  282.     (if (kview:valid-position-p)
  283.     (buffer-substring
  284.      (kotl-mode:beginning-of-line)
  285.      (kotl-mode:end-of-line))
  286.       (error "(kcell-view:line): Invalid position, '%d'" (point)))))
  287.  
  288. (defun kcell-view:next (&optional visible-p label-sep-len)
  289.   "Move to start of next cell within current view.
  290. With optional VISIBLE-P, consider only visible cells.
  291. Return t unless no next cell."
  292.   (let ((opoint (point))
  293.     pos)
  294.     ;;
  295.     ;; If a subtree is collapsed, be sure we end up at the start of a visible
  296.     ;; cell rather than within an invisible one.
  297.     (if visible-p
  298.     (progn (goto-char (kcell-view:end-contents)) (end-of-line)))
  299.     (setq pos (kproperty:next-single-change (point) 'kcell))
  300.     (if (or (null pos)
  301.         (if (goto-char pos) (kotl-mode:eobp)))
  302.     (progn (goto-char opoint)
  303.            nil)
  304.       (goto-char (kcell-view:start nil label-sep-len))
  305.       (not (eq opoint (point))))))
  306.  
  307. (defun kcell-view:operate (function &optional start end)
  308.   "Invoke FUNCTION with view restricted to current cell contents.
  309. Optional START and END are start and endpoints of cell to use."
  310.   (save-restriction
  311.     (narrow-to-region (or start (kcell-view:start))
  312.               (or end (kcell-view:end-contents)))
  313.     (funcall function)))
  314.  
  315. (defun kcell-view:parent (&optional visible-p label-sep-len)
  316.   "Move to start of current cell's parent within current view.
  317. If parent is top cell, move to first cell within view and return 0.
  318. Otherwise, return t unless optional VISIBLE-P is non-nil and the parent cell
  319. is not part of the current view."
  320.   (or label-sep-len (setq label-sep-len (kview:label-separator-length kview)))
  321.   (let ((opoint (point))
  322.     (parent-level (1- (kcell-view:level nil label-sep-len))))
  323.     (if (= parent-level 0) ;; top cell
  324.     (progn (goto-char (point-min))
  325.            (goto-char (kcell-view:start nil label-sep-len))
  326.            0)
  327.       ;; Skip from point back past any siblings
  328.       (while (kcell-view:backward visible-p label-sep-len))
  329.       ;; Move back to parent.
  330.       (if (kcell-view:previous visible-p label-sep-len)
  331.       t
  332.     ;; Move back to previous point and return nil.
  333.     (goto-char opoint)
  334.     nil))))
  335.  
  336. (defun kcell-view:previous (&optional visible-p label-sep-len)
  337.   "Move to start of previous cell within current view.
  338. With optional VISIBLE-P, consider only visible cells.
  339. Return t unless no previous cell."
  340.   (let ((opoint (point))
  341.     (pos (point)))
  342.     (goto-char (kcell-view:start nil label-sep-len))
  343.     ;;
  344.     ;; If a subtree is collapsed, be sure we end up at the start of a visible
  345.     ;; cell rather than within an invisible one.
  346.     (if visible-p
  347.     (beginning-of-line)
  348.       (if (setq pos (kproperty:previous-single-change (point) 'kcell))
  349.       (goto-char pos)))
  350.     (if (and pos (not (kotl-mode:bobp))
  351.          (setq pos (kproperty:previous-single-change (point) 'kcell)))
  352.     (progn (goto-char pos)
  353.            (skip-chars-backward "\n\^M")
  354.            (goto-char (kcell-view:start nil label-sep-len))
  355.            (not (eq opoint (point))))
  356.       ;; No previous cell exists
  357.       (goto-char opoint)
  358.       nil)))
  359.  
  360. (defun kcell-view:plist (&optional pos)
  361.   "Return properties associated with cell at optional POS or point."
  362.   (kcell:plist (kcell-view:cell pos)))
  363.  
  364. (defun kcell-view:plist-point (&optional pos)
  365.   "Return buffer position of properties associated with cell at optional POS or point."
  366.   (save-excursion (1+ (kcell-view:to-label-end pos))))
  367.  
  368. (defun kcell-view:to-label-end (&optional pos)
  369.   "Move point after end of current cell's label and return point."
  370.   (if pos (goto-char pos))
  371.   (kview:end-of-actual-line)
  372.   (cond ((null kview)
  373.      (error "(kcell-view:to-label-end): Invalid kview; try {M-x kotl-mode RET} to fix it."))
  374.     (klabel-type:changing-flag
  375.      ;; When changing from one label type to another, e.g. alpha to
  376.      ;; legal, we can't depend on the label being of the type given by
  377.      ;; the kview, so use kcell properties to find label end.
  378.      (if (kproperty:get (1- (point)) 'kcell)
  379.          nil
  380.        ;; If not at beginning of cell contents, move there.
  381.        (goto-char (kproperty:previous-single-change (point) 'kcell)))
  382.      ;; Then move to end of label via embedded kcell property.
  383.      (goto-char (kproperty:previous-single-change (point) 'kcell)))
  384.     ((funcall (kview:get-attr kview 'to-label-end))
  385.      (point))
  386.     (t (error "(kcell-view:to-label-end): Can't find end of current cell's label"))))
  387.  
  388. (defun kcell-view:reference (&optional pos relative-dir)
  389.   "Return a reference to the kcell at optional POS or point for use in a link.
  390. The reference is a list of: (kcell-file cell-ref) where cell-ref is a string
  391. consisting of the cell's relative id, a space, and the cell's permanent id.
  392. Kcell-file is made relative to optional RELATIVE-DIR before it is returned."
  393.   (list (hpath:relative-to buffer-file-name relative-dir)
  394.     (concat (kcell-view:label pos) "=" (kcell-view:idstamp pos))))
  395.  
  396. (defun kcell-view:remove-attr (attribute &optional pos)
  397.   "Remove ATTRIBUTE, if any, for current cell or cell at optional POS."
  398.   (interactive "*SAttribute to remove: ")
  399.   (save-excursion
  400.     (if pos (goto-char pos))
  401.     (let ((kcell (kcell:remove-attr (kcell-view:cell) attribute)))
  402.       (if (interactive-p)
  403.       (message "Cell <%s> now has no %s attribute."
  404.            (kcell-view:label) attribute))
  405.       kcell)))
  406.  
  407. (defun kcell-view:set-attr (attribute value &optional pos)
  408.   "Set ATTRIBUTE's VALUE for current cell or cell at optional POS."
  409.   (interactive "*SAttribute to set: \nXSet value of %s to: ")
  410.   (save-excursion
  411.     (if pos (goto-char pos))
  412.     (let ((kcell (kcell:set-attr (kcell-view:cell) attribute value)))
  413.       (if (interactive-p)
  414.       (message "Attribute %s set to %s, in cell <%s>."
  415.            attribute value (kcell-view:label)))
  416.       kcell)))
  417.  
  418. (defun kcell-view:set-cell (kcell)
  419.   "Attach KCELL property to cell at point."
  420.   (save-excursion
  421.     (kcell-view:to-label-end)
  422.     (kproperty:set 'kcell kcell)))
  423.  
  424. (defun kcell-view:sibling-p (&optional pos label-sep-len)
  425.   "Return t if cell at optional POS or point has a sibling (whether visible or not)."
  426.   (save-excursion
  427.     (if pos (goto-char pos))
  428.     (kcell-view:forward nil label-sep-len)))
  429.  
  430. (defun kcell-view:start (&optional pos label-sep-len)
  431.   "Return start position of cell contents from optional POS or point."
  432.   (save-excursion
  433.     (+ (kcell-view:to-label-end pos)
  434.        (or label-sep-len (kview:label-separator-length kview)))))
  435.  
  436. ;;;
  437. ;;; kview - one view per buffer, multiple views per kotl
  438. ;;;
  439.  
  440. (defun kview:add-cell (klabel level &optional contents prop-list no-fill)
  441.   "Create a new cell with full KLABEL and add it at point at LEVEL within outline.
  442. 1 = first level.  Optional cell CONTENTS and PROP-LIST may also be given, as
  443. well as NO-FILL which skips filling of any CONTENTS.
  444. Return new cell."
  445.   (let ((new-cell (kcell:create contents (kview:id-increment kview)
  446.                 prop-list)))
  447.     (kcell-view:create kview new-cell level klabel no-fill)
  448.     new-cell))
  449.  
  450. (defun kview:buffer (kview)
  451.   "Return kview's buffer or nil if argument is not a kview."
  452.   (if (kview:is-p kview)
  453.       (get-buffer (kview:get-attr kview 'view-buffer-name))))
  454.  
  455. (defun kview:create (buffer-name
  456.              &optional id-counter label-type level-indent
  457.              label-separator label-min-width) 
  458.   "Return a new kview for BUFFER-NAME.
  459. Optional ID-COUNTER is the maximum permanent id previously given out in this
  460. outline.  Optional LABEL-TYPE, LEVEL-INDENT, LABEL-SEPARATOR, and
  461. LABEL-MIN-WIDTH may also be given, otherwise default values are used.
  462.  
  463.   See documentation of:
  464.  'kview:default-label-type' for LABEL-TYPE,
  465.  'kview:default-level-indent' for LEVEL-INDENT,
  466.  'kview:default-label-separator' for LABEL-SEPARATOR,
  467.  'kview:default-label-min-width' for LABEL-MIN-WIDTH."
  468.  
  469.   (let ((buf (get-buffer buffer-name))
  470.     )
  471.     (cond ((null buf)
  472.        (error "(kview:create): No such buffer, '%s'." buffer-name))
  473.       ((or (null id-counter) (= id-counter 0))
  474.        (setq id-counter 0))
  475.       ((not (integerp id-counter))
  476.        (error "(kview:create): 2nd arg, '%s', must be an integer." id-counter)))
  477.     (set-buffer buf)
  478.     (if (and (boundp 'kview) (eq (kview:buffer kview) buf))
  479.     ;; Don't recreate view if it exists.
  480.     nil
  481.       (make-local-variable 'kview)
  482.       (setq kview
  483.         (list 'kview 'plist
  484.           (list 'view-buffer-name buffer-name
  485.             'top-cell
  486.             (kcell:create-top buffer-file-name id-counter)
  487.             'label-type (or label-type kview:default-label-type)
  488.             'label-min-width (or label-min-width
  489.                          kview:default-label-min-width)
  490.             'label-separator (or label-separator
  491.                          kview:default-label-separator)
  492.             'label-separator-length
  493.             (length (or label-separator
  494.                     kview:default-label-separator))
  495.             'level-indent (or level-indent
  496.                       kview:default-level-indent))))
  497.       (kview:set-functions (or label-type kview:default-label-type)))
  498.     kview))
  499.  
  500. ;;; Using this stimulates an GNU Emacs V19.19 bug in text-property handling,
  501. ;;  visible when one deletes a sibling cell and then deletes the prior cell,
  502. ;;  the following cell is left with a different idstamp and its label
  503. ;;  displays as "0".  Using delete-char here would solve the problem but we
  504. ;;  suggest you upgrade to a newer version of GNU Emacs in which the bug is
  505. ;;  fixed.
  506. (defun kview:delete-region (start end)
  507.   "Delete cells between START and END points from current view."
  508.   (delete-region start end))
  509.  
  510. (defun kview:end-of-actual-line ()
  511.   "Go to the end of the current line whether collapsed or not."
  512.   (if (re-search-forward "[\n\^M]" nil 'move)
  513.       (backward-char 1)))
  514.  
  515. (defun kview:fill-region (start end &optional kcell justify)
  516.   "Fill region between START and END within current view.
  517. With optional KCELL, assume START and END delimit that cell's contents.
  518. With optional JUSTIFY, justify region as well.
  519. Fill-prefix must be a string of spaces the length of this cell's indent, when
  520. this function is called."
  521.   (let ((opoint (set-marker (make-marker) (point)))
  522.     (label-sep-len (kview:label-separator-length kview))
  523.     (continue t)
  524.     prev-point)
  525.     (goto-char start)
  526.     (while continue
  527.       (if (kcell:get-attr (or kcell (kcell-view:cell)) 'no-fill)
  528.       (setq continue (kcell-view:next nil label-sep-len))
  529.     (fill-paragraph justify t)
  530.     (setq prev-point (point))
  531.     (forward-paragraph)
  532.     (re-search-forward "[^ \t\n\^M]" nil t))
  533.       (setq continue (and continue
  534.               (/= (point) prev-point)
  535.               (< (point) (min end (point-max))))))
  536.     ;; Return to original point.
  537.     (goto-char opoint)
  538.     (set-marker opoint nil)))
  539.  
  540. (cond ((and hyperb:xemacs-p (or (>= emacs-minor-version 12)
  541.                 (> emacs-major-version 19)))
  542.        (defun kview:goto-cell-id (id-string)
  543.      "Move point to start of cell with idstamp ID-STRING and return t, else nil."
  544.      (let ((cell-id (string-to-int id-string))
  545.            label-end kcell)
  546.        (setq label-end
  547.          (map-extents
  548.           (function (lambda (extent unused)
  549.                   (setq kcell (extent-property extent 'kcell))
  550.                   (if (= (kcell:idstamp kcell) cell-id)
  551.                   (extent-end-position extent))))
  552.           nil nil nil nil nil 'kcell))
  553.        (if (null label-end)
  554.            nil
  555.          (goto-char label-end)
  556.          t))))
  557.       (hyperb:lemacs-p
  558.        (defun kview:goto-cell-id (id-string)
  559.      "Move point to start of cell with idstamp ID-STRING and return t, else nil."
  560.      (let ((cell-id (string-to-int id-string))
  561.            label-end kcell)
  562.        (setq label-end
  563.          (map-extents
  564.           (function (lambda (extent unused)
  565.                   (setq kcell (extent-property extent 'kcell))
  566.                   (and kcell (= (kcell:idstamp kcell) cell-id)
  567.                    (extent-end-position extent))))))
  568.        (if (null label-end)
  569.            nil
  570.          (goto-char label-end)
  571.          t))))
  572.       ;; Emacs 19
  573.       (t (defun kview:goto-cell-id (id-string)
  574.        "Move point to start of cell with idstamp ID-STRING and return t, else nil."
  575.        (let ((cell-id (string-to-int id-string))
  576.          (opoint (point))
  577.          pos kcell)
  578.          (goto-char (point-min))
  579.          (while (and (setq pos
  580.                    (kproperty:next-single-change (point) 'kcell))
  581.              (goto-char pos)
  582.              (or (null (setq kcell (kproperty:get pos 'kcell)))
  583.                  (/= (kcell:idstamp kcell) cell-id))))
  584.          (if pos
  585.          (progn
  586.            (forward-char (kview:label-separator-length kview))
  587.            t)
  588.            (goto-char opoint)
  589.            nil))))
  590. )
  591.  
  592. (defun kview:id-increment (kview)
  593.   "Return next idstamp (an integer) for KVIEW."
  594.   (let* ((top-cell (kview:get-attr kview 'top-cell))
  595.      (counter (1+ (kcell:get-attr top-cell 'id-counter))))
  596.     (kcell:set-attr top-cell 'id-counter counter)
  597.     counter))
  598.  
  599. (defun kview:idstamp-to-label (permanent-id)
  600.   "Return relative label for cell with PERMANENT-ID within current kview."
  601.   (save-excursion
  602.     (if (kotl-mode:goto-cell permanent-id)
  603.     (kcell-view:label))))
  604.  
  605. (defun kview:insert-contents (kcell contents no-fill)
  606.   "Insert KCELL's CONTENTS into view at point and fill resulting paragraphs, unless NO-FILL is non-nil.
  607. If CONTENTS is nil, get contents from KCELL.  Return contents inserted (this
  608. value may differ from the value passed in.)
  609.  
  610. Fill-prefix must be a string of spaces the length of this cell's indent, when
  611. this function is called."
  612.   (let ((start (point))
  613.     end)
  614.     (setq contents (or contents (kcell:contents kcell) ""))
  615.     (insert contents)
  616.     ;;
  617.     ;; Delete any extra newlines at end of cell contents.
  618.     (setq end (point))
  619.     (skip-chars-backward "\n\^M")
  620.     (delete-region (point) end)
  621.     (setq end (point))
  622.     ;;
  623.     (if no-fill
  624.     ;; Insert proper indent in all but the first line which has
  625.     ;; already been indented.
  626.     (progn
  627.       (narrow-to-region start end)
  628.       (goto-char (point-min))
  629.       (while (re-search-forward "[\n\^M]" nil t)
  630.         (insert fill-prefix))
  631.       (goto-char (point-max)))
  632.       ;;
  633.       ;; Filling cell will insert proper indent on all lines.
  634.       (if (equal contents "")
  635.       nil
  636.     (goto-char start)
  637.     (beginning-of-line)
  638.     (narrow-to-region (point) end)
  639.     ;; Add fill-prefix to all but paragraph separator lines, so
  640.     ;; filling is done properly.
  641.     (while (re-search-forward "[\n\^M][^\n\^M]" nil t)
  642.       (forward-char -1) (insert fill-prefix))
  643.     (kview:fill-region start end kcell)
  644.     (goto-char (point-min))
  645.     ;; Now add fill-prefix to paragraph separator lines.
  646.     (while (re-search-forward "[\n\^M][\n\^M]" nil t)
  647.       (forward-char -1) (insert fill-prefix))
  648.     ;;
  649.     (goto-char (point-max))))
  650.     contents))
  651.  
  652. (defun kview:is-p (object)
  653.   "Is OBJECT a kview?"
  654.   (and (listp object) (eq (car object) 'kview)))
  655.  
  656. (defun kview:kotl (kview)
  657.   "Return kview's kotl object or nil if argument is not a kview."
  658.   (if (kview:is-p kview)
  659.       (kview:get-attr kview 'kotl)))
  660.  
  661. (defun kview:label (klabel-function prev-label child-p)
  662.   "Return label string to display for current cell computed from KLABEL-FUNCTION, PREV-LABEL and CHILD-P."
  663.   (funcall klabel-function prev-label child-p))
  664.  
  665. (defun kview:label-function (kview)
  666.   "Return function which will return display label for current cell in KVIEW.
  667. Function signature is: (func prev-label &optional child-p), where prev-label
  668. is the display label of the cell preceding the current one and child-p is
  669. non-nil if cell is to be the child of the preceding cell."
  670.   (kview:get-attr kview 'label-function))
  671.  
  672. (defun kview:label-min-width (kview)
  673.   "Return kview's label-min-width setting or nil if argument is not a kview.
  674. See documentation for kview:default-label-min-width."
  675.   (if (kview:is-p kview)
  676.       (kview:get-attr kview 'label-min-width)))
  677.  
  678. (defun kview:label-separator (kview)
  679.   "Return kview's label-separator setting or nil if argument is not a kview.
  680. See documentation for kview:default-label-separator."
  681.   (if (kview:is-p kview)
  682.       (kview:get-attr kview 'label-separator)))
  683.  
  684. (defun kview:label-separator-length (kview)
  685.   "Return kview's label-separator length or nil if argument is not a kview.
  686. See documentation for kview:default-label-separator."
  687.   (kview:get-attr kview 'label-separator-length))
  688.  
  689. (defun kview:label-type (kview)
  690.   "Return kview's label-type setting or nil if argument is not a kview.
  691. See documentation for kview:default-label-type."
  692.   (if (kview:is-p kview)
  693.       (kview:get-attr kview 'label-type)))
  694.  
  695. (defun kview:level-indent (kview)
  696.   "Return kview's level-indent setting or nil if argument is not a kview.
  697. See documentation for kview:default-level-indent."
  698.   (if (kview:is-p kview)
  699.       (kview:get-attr kview 'level-indent)))
  700.  
  701. (defun kview:map-branch (func kview &optional first-p visible-p)
  702.   "Applies FUNC to the sibling trees from point forward within KVIEW and returns results as a list.
  703. With optional FIRST-P non-nil, begins with first sibling in current branch.
  704. With optional VISIBLE-P, considers only those sibling cells that are visible
  705. in the view.
  706.  
  707. FUNC should take one argument, the kview local variable of the current
  708. buffer or some other kview, and should operate upon the cell at point.
  709.  
  710. `Cell-indent' contains the indentation value of the first cell mapped when
  711. FUNC is called so that it may test against this value.  `Label-sep-len'
  712. contains the label separator length.
  713.  
  714. See also 'kview:map-siblings' and 'kview:map-tree'."
  715.     (save-excursion
  716.       (set-buffer (kview:buffer kview))
  717.       (let ((results)
  718.         (label-sep-len (kview:label-separator-length kview)))
  719.     (if first-p
  720.         ;; Move back to first predecessor at same level.
  721.         (while (kcell-view:backward t label-sep-len)))
  722.     (let ((cell-indent (kcell-view:indent nil label-sep-len)))
  723.       ;; Terminate when no further cells or when reach a cell at an equal
  724.       ;; or higher level in the kotl than the first cell that we processed.
  725.       (while (and (progn (setq results (cons (funcall func kview) results))
  726.                  (kcell-view:next visible-p label-sep-len))
  727.               (> (kcell-view:indent nil label-sep-len) cell-indent))))
  728.     (nreverse results))))
  729.  
  730. (defun kview:map-siblings (func kview &optional first-p visible-p)
  731.   "Applies FUNC to the sibling cells from point forward within KVIEW and returns results as a list.
  732. With optional FIRST-P non-nil, begins with first sibling in current branch.
  733. With optional VISIBLE-P, considers only those sibling cells that are visible
  734. in the view.
  735.  
  736. FUNC should take one argument, the kview local variable of the current
  737. buffer or some other kview, and should operate upon the cell at point.
  738.  
  739. `Cell-indent' contains the indentation value of the first cell mapped when
  740. FUNC is called so that it may test against this value.  `Label-sep-len'
  741. contains the label separator length.
  742.  
  743. See also 'kview:map-branch' and 'kview:map-tree'."
  744.     (save-excursion
  745.       (set-buffer (kview:buffer kview))
  746.       (let ((results)
  747.         (label-sep-len (kview:label-separator-length kview)))
  748.     (if first-p
  749.         ;; Move back to first predecessor at same level.
  750.         (while (kcell-view:backward t label-sep-len)))
  751.     (let ((cell-indent (kcell-view:indent nil label-sep-len)))
  752.       ;; Terminate when no further cells at same level.
  753.       (while (progn (setq results (cons (funcall func kview) results))
  754.             (kcell-view:forward visible-p label-sep-len))))
  755.     (nreverse results))))
  756.  
  757. (defun kview:map-tree (func kview &optional top-p visible-p)
  758.   "Applies FUNC to the tree starting at point within KVIEW and returns results as a list.
  759. With optional TOP-P non-nil, maps over all of kview's cells.
  760. With optional VISIBLE-P, considers only those cells that are visible in the
  761. view.
  762.  
  763. FUNC should take one argument, the kview local variable of the current
  764. buffer or some other kview, and should operate upon the cell at point.
  765.  
  766. `Cell-indent' contains the indentation value of the first cell mapped when
  767. FUNC is called so that it may test against this value.  `Label-sep-len'
  768. contains the label separator length.
  769.  
  770. See also 'kview:map-branch' and 'kview:map-siblings'."
  771.   (let ((results)
  772.     (label-sep-len (kview:label-separator-length kview)))
  773.     (save-excursion
  774.       (set-buffer (kview:buffer kview))
  775.       (if top-p
  776.       (progn (goto-char (point-min))
  777.          (kview:end-of-actual-line)
  778.          ;; Terminate when no further cells to process.
  779.          (while (progn 
  780.               (setq results (cons (funcall func kview) results))
  781.               (kcell-view:next visible-p label-sep-len))))
  782.     (let ((cell-indent (kcell-view:indent nil label-sep-len)))
  783.       ;; Terminate when no further cells or when reach a cell at an equal
  784.       ;; or higher level in the kotl than the first cell that we processed.
  785.       (while (and (progn (setq results (cons (funcall func kview) results))
  786.                  (kcell-view:next visible-p label-sep-len))
  787.               (> (kcell-view:indent nil label-sep-len)
  788.              cell-indent))))))
  789.     (nreverse results)))
  790.  
  791. (defun kview:move (from-start from-end to-start from-indent to-indent
  792.                    &optional copy-p fill-p)
  793.   "Move tree between FROM-START and FROM-END to TO-START, changing FROM-INDENT to TO-INDENT.
  794. Copy tree if optional COPY-P is non-nil.  Refill cells if optional
  795. FILL-P is non-nil.  Leave point at TO-START."
  796.   (let ((region (buffer-substring from-start from-end))
  797.     (new-start (set-marker (make-marker) to-start))
  798.     collapsed-cells    expr new-end space)
  799.     ;;
  800.     ;; Move or copy tree region to new location.
  801.     (or copy-p (delete-region from-start from-end))
  802.     (goto-char new-start)
  803.     (insert region)
  804.     (setq new-end (point))
  805.     ;;
  806.     ;; Change indentation of tree cells.
  807.     (if (/= from-indent to-indent)
  808.     (save-restriction
  809.       (narrow-to-region new-start new-end)
  810.       ;; Store list of which cells are presently collapsed.
  811.       (setq collapsed-cells
  812.         (kview:map-tree
  813.          (function (lambda (view)
  814.                  ;; Use free variable label-sep-len bound in
  815.                  ;; kview:map-tree for speed.
  816.                  (kcell-view:collapsed-p nil label-sep-len)))
  817.          kview t))
  818.       ;; Expand all cells.
  819.       (subst-char-in-region new-start new-end ?\^M ?\n t)
  820.       ;;
  821.       (goto-char (point-min))
  822.       (if (< from-indent to-indent)
  823.           ;; Add indent
  824.           (progn
  825.         (setq expr (make-string (1+ (- to-indent from-indent)) ?\ ))
  826.         (while (re-search-forward "^ " nil t)
  827.           (replace-match expr t t)
  828.           (forward-line 1)))
  829.         ;; Reduce indent in all but first cell lines.
  830.         (setq expr (concat "^" (make-string
  831.                     (- from-indent to-indent) ?\ )))
  832.         (while (re-search-forward expr nil t)
  833.           (replace-match "" t t)
  834.           (forward-line 1))
  835.         ;; Reduce indent in first cell lines which may have an
  836.         ;; autonumber or other cell delimiter.
  837.         (setq space (- from-indent to-indent
  838.                (kview:label-separator-length kview)
  839.                1))
  840.         (if (zerop space)
  841.         nil
  842.           (setq expr (concat "^" (make-string
  843.                       (- from-indent to-indent
  844.                      (kview:label-separator-length kview)
  845.                      1)
  846.                       ?\ )))
  847.           (kview:map-tree
  848.            (function (lambda (view)
  849.                (save-excursion
  850.                  (beginning-of-line)
  851.                  (if (looking-at expr)
  852.                  (replace-match "" t t)))))
  853.            kview t)))
  854.       ;;
  855.       (if fill-p
  856.           ;; Refill cells without no-fill property.
  857.           (kview:map-tree (function (lambda (view)
  858.                       (kotl-mode:fill-cell nil t)))
  859.                   kview t))
  860.       ;;
  861.       ;; Collapse temporarily expanded cells.
  862.       (if (delq nil collapsed-cells)
  863.           (kview:map-tree
  864.            (function
  865.         (lambda (view)
  866.           (if (car collapsed-cells)
  867.               ;; Use free variable label-sep-len bound in
  868.               ;; kview:map-tree for speed.
  869.               (kcell-view:collapse nil label-sep-len))
  870.           (setq collapsed-cells (cdr collapsed-cells))))
  871.            kview t))))
  872.     ;;
  873.     (goto-char new-start)
  874.     ;;
  875.     ;; Delete temporary markers.
  876.     (set-marker new-start nil)))
  877.  
  878. (defun kview:set-buffer-name (kview new-name)
  879.   "Set kview's buffer name to NEW-NAME."
  880.   (if (kview:is-p kview)
  881.       (save-excursion
  882.     (let ((buf (kview:buffer kview)))
  883.       (if buf (set-buffer buf)))
  884.     (kview:set-attr kview 'view-buffer-name new-name))
  885.     (error "(kview:set-buffer-name): Invalid kview argument")))
  886.  
  887. (defun kview:set-label-type (kview new-type)
  888.   "Change kview's label display type to NEW-TYPE, updating all displayed labels.
  889. See documentation for variable, kview:default-label-type, for
  890. valid values of NEW-TYPE."
  891.   (interactive (list kview
  892.              (let ((completion-ignore-case)
  893.                (label-type (kview:label-type kview))
  894.                new-type-str)
  895.                (if (string=
  896.                 ""
  897.                 (setq new-type-str
  898.                   (completing-read
  899.                    (format "View label type (current = %s): "
  900.                        label-type)
  901.                    '(("alpha") ("legal") ("id") ("no")
  902.                      ("partial-alpha") ("star"))
  903.                    nil t)))
  904.                label-type
  905.              (intern new-type-str)))))
  906.   (if (not (memq new-type '(alpha legal id no partial-alpha star)))
  907.       (error "(kview:set-label-type): Invalid label type, '%s'." new-type))
  908.   ;; Disable use of partial-alpha for now since it is broken.
  909.   (if (eq new-type 'partial-alpha)
  910.       (error "(kview:set-label-type): Partial-alpha labels don't work, choose another type"))
  911.   (let ((old-label-type (kview:label-type kview)))
  912.     (if (eq old-label-type new-type)
  913.     nil
  914.       (klabel-type:set-labels new-type)
  915.       (kview:set-attr kview 'label-type new-type)
  916.       (kview:set-functions new-type))))
  917.  
  918. (defun kview:top-cell (kview)
  919.   "Return kview's invisible top cell with idstamp 0 or nil if argument is not a kview."
  920.   (if (kview:is-p kview)
  921.       (kview:get-attr kview 'top-cell)))
  922.  
  923. (defun kview:valid-position-p (&optional pos)
  924.   "Return non-nil iff point or optional POS is at a position where editing may occur.
  925. The read-only positions between cells and within cell indentations are invalid."
  926.   (cond ((null pos)
  927.      (>= (current-column) (kcell-view:indent)))
  928.     ((not (integer-or-marker-p pos))
  929.      (error "(kview:valid-position-p): Argument POS not an integer
  930. or marker, '%s'" pos))
  931.     ((or (< pos (point-min)) (> pos (point-max)))
  932.      (error "(kview:valid-position-p): Invalid POS argument, '%d'"
  933.         pos))
  934.     (t (save-excursion
  935.          (goto-char pos)
  936.          (>= (current-column) (kcell-view:indent))))))
  937.  
  938. ;;; ************************************************************************
  939. ;;; Private functions
  940. ;;; ************************************************************************
  941.  
  942. (defun kview:get-attr (obj attribute)
  943.   "Return the value of OBJECT's ATTRIBUTE."
  944.   (car (cdr (memq attribute (car (cdr (memq 'plist obj)))))))
  945.  
  946. (defun kview:set-attr (obj attribute value)
  947.   "Set OBJECT's ATTRIBUTE to VALUE and return VALUE."
  948.   (let* ((plist-ptr (cdr (memq 'plist obj)))
  949.      (plist (car plist-ptr))
  950.      (attr (memq attribute plist)))
  951.     (if attr
  952.     (setcar (cdr attr) value)
  953.       (setcar plist-ptr
  954.           (nconc (list attribute value) plist)))
  955.     value))
  956.  
  957. (defun kview:set-functions (label-type)
  958.   "Setup functions which handle labels of LABEL-TYPE for current view."
  959.   (kview:set-attr kview 'label-function (klabel-type:function label-type))
  960.   (kview:set-attr kview 'label-child (klabel-type:child label-type))
  961.   (kview:set-attr kview 'label-increment (klabel-type:increment label-type))
  962.   (kview:set-attr kview 'label-parent (klabel-type:parent label-type))
  963.   (kview:set-attr kview 'to-label-end (klabel-type:to-label-end label-type)))
  964.  
  965. (defun kview:set-label-separator (kview label-separator)
  966.   "Set within KVIEW the LABEL-SEPARATOR (a string) between labels and cell contents."
  967.   (kview:set-attr kview 'label-separator label-separator)
  968.   (kview:set-attr kview 'label-separator-length (length label-separator)))
  969.  
  970. (provide 'kview)
  971.